home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
bbs_util
/
cdesc110.zip
/
ARCID.PAS
next >
Wrap
Pascal/Delphi Source File
|
1996-04-12
|
7KB
|
240 lines
{$N-,E- no math support needed}
{$X- function calls may not be discarded}
{$I- disable I/O checking (trap errors by checking IOResult)}
UNIT ArcID;
(* A Pascal unit which will determine most major archive types.
To use this unit, simply define a VAR of ARCTYPE, and then
call the function as follows:
VAR FileID : ARCTYPE;
FileID := IsArc (FileName.Ext);
CASE FileID OF
NONE : Writeln ('Unknown');
ZIP : Writeln ('ZIP');
ARC : Writeln ('ARC');
... etc.
END;
Returns NONE if unable to identify, otherwise one of these:
ACB, AIN, ARC, ARJ, HA, HAP, HPK, HYP, JRC, LIB,
LIM, LZH, LZS, PAK, PAQ, PUT, RAR, SAR, SQZ, UC2,
YC, ZIP, ZOO
Credit: Many of the ID strings came from GUS (General Unpack Shell).
*)
INTERFACE
TYPE
ARCTYPE =
(NONE,ACB,AIN,ARC,ARJ,HA,HAP,HPK,HYP,JRC,LIB,LIM,LZH,LZS,PAK,PAQ,PUT,RAR,SAR,SQZ,UC2,YC,ZIP,ZOO);
FUNCTION IsArc (FName : STRING) : ARCTYPE;
IMPLEMENTATION
VAR
IDStrh: STRING;
FUNCTION Byte_To_Hex(X : byte) : String;
CONST
Digits : array [0..15] of char = '0123456789ABCDEF';
BEGIN { Byte_To_Hex }
Byte_To_Hex := Concat(Digits[X shr 4],Digits[X and 15]);
END; { Byte_To_Hex }
FUNCTION StrToHex (str: STRING; len: BYTE): STRING;
VAR
NewStr : STRING;
Index : WORD;
BEGIN
NewStr := '';
For Index := 1 to len DO
NewStr := NewStr + Byte_To_Hex (Ord (str [Index]));
StrToHex := NewStr;
END;
FUNCTION CheckID (Offset: BYTE; IDhex: STRING): BOOLEAN;
BEGIN
CheckID := Copy (IDStrh, Offset, Length (IDhex)) = IDhex;
END;
FUNCTION IsArc (FName : STRING) : ARCTYPE;
VAR
ArcFile : FILE;
ArcID : ARCTYPE;
IDarr : Array[1..64] OF CHAR;
IDStr,
IDhex : STRING;
Index,
BytesRead : INTEGER;
BEGIN
ArcID := NONE; {If none of the above}
Assign (ArcFile, FName);
Reset (ArcFile,1);
IF IOResult = 0 THEN
BEGIN
BlockRead (ArcFile, IDarr, SizeOf (IDarr), BytesRead);
Close (ArcFile);
IDStr[0] := Chr (64);
Move (IDarr[1], IDStr[1], BytesRead);
IDStrh := StrToHex (IDStr, 64);
{ARJ SFX}
IF CheckID (1, '4D5A0A001E0000000200640FFFFF3D05800000000E0088031C0000005'+
'24A5358FFFFBA40042E89163A02B430CD218B2E02FFFF008B1E2C008EDAA390008C068E')
THEN ArcID := ARJ ELSE
IF CheckID (1, '4D5AD1000B0000000200120EFFFFCB01800000000E0035011C0000005'+
'24A5358FFFFBA62012E89163A02B430CD218B2E02FFFF008B1E2C008EDAA390008C068E')
THEN ArcID := ARJ ELSE
IF CheckID (1, '4D5AEA00240000000200F50FFFFF9106800000000E0056041C0000005'+
'24A5358FFFFBA5E052E89163A02B430CD218B2E02FFFF008B1E2C008EDAA390008C068E')
THEN ArcID := ARJ ELSE
{LHA SFX}
IF CheckID (1, '4D5A99010400000002000010FFFFF0FF000100000001F0FF1C0000000'+
'0000000EB7920004C484127732053465820322E31334C2028632920596F7368692C2031')
THEN ArcID := LZH ELSE
IF CheckID (1, '4D5A64000400000002000010FFFFF0FF000100000001F0FF1C0000000'+
'0000000EB7920004C484127732053465820322E3133532028632920596F7368692C2031')
THEN ArcID := LZH ELSE
{PAK SFX}
IF CheckID (1, '4D5AD3000E00060020007900FFFF8E0180070000E10900003E0000000'+
'100FB306A7200000000000000000000000000000000000000000000000000000000A605')
THEN ArcID := PAK ELSE
{ZIP SFX}
IF CheckID (1, '4D5AEF01190000000600D10CFFFF2003000400000001F0FF1E0000000'+
'001436F7079726967687420313938392D3139393020504B5741524520496E632E20416C')
THEN ArcID := ZIP ELSE
IF CheckID (1, '4D5A76010600000002000206FFFFF0FF706700000001F0FF1E0000000'+
'0000000B87067A34E0CBF560CB9705F2BCF32C0F3AAB430CD21A3520CA12C00A3500CE8')
THEN ArcID := ZIP ELSE
IF CheckID (1, '4D5A99011F0001000600890CFFFF0000206100000001F0FF520000001'+
'411504B4C49544520436F70722E20313939302D393220504B5741524520496E632E2041')
THEN ArcID := ZIP ELSE
IF CheckID (1, '4D5ABA01060000000200890B0010F0FF1CC000000001F0FF1E0000000'+
'0000000B91CBABF9A0C2BCF32C0F3AAB430CD21A302BA892614BAE83300B8A80AE8D401')
THEN ArcID := ZIP ELSE
IF CheckID (1, '4D5AF5011E0001000600890CFFFF0000B05F00000001F0FF520000001'+
'411504B4C49544520436F70722E20313939302D393220504B5741524520496E632E2041')
THEN ArcID := ZIP ELSE
IF NOT CheckID (1, '4D5A') THEN { If file is .EXE, go no further. }
BEGIN
{AIN}
IF CheckID (1, '21') AND CheckID (5, '00') {!+?+NUL}
THEN ArcID := AIN ELSE
{HA}
IF CheckID (1, '4841') {HA}
THEN ArcID := HA ELSE
{JRC}
IF CheckID (1, '4A526368697665') {JRchive}
THEN ArcID := JRC ELSE
{PAQ}
IF CheckID (1, '44530060') {DS`}
THEN ArcID := PAQ ELSE
{SQZ}
IF CheckID (1, '484C53515A') {HLSQZ}
THEN ArcID := SQZ ELSE
{HPACK}
IF CheckID (1, '4850414B') {HPAK}
THEN ArcID := HPK ELSE
{LIM}
IF CheckID (1, '4C4D1A') {LM+ESC}
THEN ArcID := LIM ELSE
{ZIP}
IF CheckID (1, '504B0304') {PK..}
THEN ArcID := ZIP ELSE
{RAR}
IF CheckID (1, '526172') {Rar}
THEN ArcID := RAR ELSE
{UC2}
IF CheckID (1, '5543321A') {UC2+ESC+}
THEN ArcID := UC2 ELSE
{ZOO - MS DOS}
IF CheckID (1, '5A4F4F') {ZOO - only at beginning on MS-DOS machines!}
THEN ArcID := ZOO ELSE
{ARJ}
IF CheckID (1, '60EA') {`Ω}
THEN ArcID := ARJ ELSE
{CODEC}
IF CheckID (1, '76FF31') {v 1}
THEN ArcID := LIB ELSE
{HAP/PAH}
IF CheckID (1, '91334846') {æ3HF}
THEN ArcID := HAP ELSE
{LHA (& LHARC?)}
IF CheckID (5, '2D6C68') {-lh}
THEN ArcID := LZH ELSE
{SAR}
IF CheckID (5, '204C48') { LH *Note: SAR uses LHA v2.13 compression.}
THEN ArcID := SAR ELSE
{PUT}
IF CheckID (5, '2D6C5A') {-lZ *Note: PUT uses LHA v2.13 compression.}
THEN ArcID := PUT ELSE
{LARC}
IF CheckID (5, '2D6C7A') {-lz}
THEN ArcID := LZS ELSE
{ZOO}
IF CheckID (41, 'DCA7C4FD') {▄º─²}
THEN ArcID := ZOO ELSE
{YAC}
IF CheckID (29, '5943') {YC}
THEN ArcID := YC ELSE
{ARC+}
IF CheckID (1, '1A14') {+ESC+}
THEN ArcID := ARC ELSE
{HYPER}
IF ((IDStr[1] = #$1a) AND (IDStr[2] >= #$48))
THEN ArcID := HYP ELSE
{PAK}
IF ((IDStr[1] = #$1a) AND (IDStr[2] >= #$0a))
THEN ArcID := PAK ELSE
{ARC}
IF CheckID (1, '1A') {+ESC+}
THEN ArcID := ARC ELSE
{ACB}
IF CheckID (3, '80') {Ç}
THEN ArcID := ACB ELSE
BEGIN END; { This satisfies the final ELSE clause. }
END;
END;
IsArc := ArcID;
END;
END.